#include "types.h"
#include "assert.h"
#include "string.h"
#include "stdlib.h"
#include "builtin.h"
#include <gc/gc.h>

/*
TODO:
  - Track down double increments of column
CONSIDER:
- How do we handle callables?
  - (<list> 5) = 6th item of the list?
  - (<list> 5 'a') = list with 5th item set to 'a'?
*/

/*
  Allocates a value of type 'value_type' and sets its 'type' member.
  Returns a pointer to the newly allocated value.
*/

unsigned int allocCount = 0;
unsigned int allocCounts[] =
  { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };

unsigned int tags = 0;
unsigned int names = 0;

/*
WARNING: Not thread-safe at present
- pthreadify it?
*/
trampoline_t thread_trampoline_buffer
  = { type_trampoline, 0, 0, 0 };

value_t *allocate_type(type_t value_type)
{
  const size_t value_size = sizeof(value_t);
  //allocCount++;
  //allocCounts[value_type-1]++;
  value_t *new_value;
  new_value = GC_MALLOC(1*value_size);
  //(new_value->generic).data = GC_MALLOC(sizeof(node_data));
  (new_value->generic).type = value_type;
  return new_value;
}

int has_type(void *value, type_t type)
{
  return (type == get_type(value)); 
}

type_t get_type(value_t *value)
{
  if(!is_tagged_pointer(value))
    return value->generic.type;

  // If value is a tagged pointer, inspect the packed type field

  switch(unpack_pointer_tag(value))
  {
    case 0x01:
      return type_integer;
    case 0x05:
      return type_tag;
    case 0x81:
      return type_name;
    default:
      assert(0);
  }
}

int comparable_types(value_t *a, value_t *b)
{
  return 
    (get_type(a) == get_type(b))
      || (is_iterable(a) && is_iterable(b))
      || (is_numeric(a) && is_numeric(b));
}

int is_numeric(value_t *value)
{
  type_t value_type = get_type(value);

  return
    (value_type == type_integer)
    || (value_type == type_float);
}

/*
  Takes a concrete value and asserts that it is iterable
*/
int is_iterable(value_t *value)
{
  type_t value_type = get_type(value);

  return
    (value_type == type_list)
    || (value_type == type_string);
}

int is_callable(value_t *value)
{
  switch(get_type(value))
  {
    case type_closure:
    case type_builtin:
    case type_tag:
      return 1;
    default:
      return 0;
  }
}

int has_variable_arity(value_t *value)
{
  switch(get_type(value))
  {
    case type_tag:
      return 0;
    case type_builtin:
      return value->builtin.varargs;
    case type_closure:
      value = (value_t*)value->closure.function;
    case type_function:
      return (0 != value->function.tail);
    default:
      return -1;
  }
}

int get_arity(value_t *value)
{
  switch(get_type(value))
  {
    case type_tag:
      return 1;
    
    case type_builtin:
      return value->builtin.arity;

    case type_closure:
    {
      if(value->closure.function->arguments)
      {
        // Should we have to dig this deep?
        return value->closure.function->arguments->length;
      }
      else
      {
        return 0;
      }
    }
    
    case type_function:
    {
      if(value->function.arguments)
      {
        return value->function.arguments->length;
      }
      else
      {
        return 0;
      }
    }

    default:
      return -1;
  }
}

int has_arity(value_t *value, int arguments)
{
  assert(is_callable(value));

  if(has_variable_arity(value))
  {
    return (arguments >= get_arity(value));
  }
  else
  {
    return (arguments == get_arity(value));
  }
}

int is_recursive(value_t *value)
{
  return value->function.recursive;
}

int promote(value_t **a, value_t **b)
{
  type_t a_type = get_type(*a);
  type_t b_type = get_type(*b);

  if(a_type == b_type)
  {
    // No promotion required
    return 0;
  }

  if(is_iterable(*a) && is_iterable(*b))
  {
    // Iterable promotions are always string -> list
    value_t **candidate = has_type(*a, type_string) ? a : b;
    
    *candidate = (value_t*)string_to_list((string_t*)*candidate);
    return 1;
  }
  else if(is_numeric(*a) && is_numeric(*b))
  {
    // Numeric promotions are always integer -> float
    value_t **candidate = has_type(*a, type_integer) ? a : b;
    
    *candidate = (value_t*)integer_to_float((integer_t*)*candidate);
    return 1;
  }
  else
  {
    // No valid promotion
    return -1;
  }
}

int get_length(value_t *value)
{
  switch(get_type(value))
  {
    case type_list:
      return value->list.items ? value->list.items->length : 0;
    case type_string:
      return u_strlen(value->string.value);
    default:
      return (-1);
  }
}

value_t *pack_tagged_pointer(uint8_t tag, uint32_t payload)
{
  /*
    If you're endian-order dependent and you know it,
    clap your hands! Work needed when we move beyond x86-64
  */

  uintptr_t qword = ((uintptr_t) payload << (POINTER_SIZE/2));
  uintptr_t lword = (uintptr_t) tag;
  return (value_t*) (qword | lword);
}

float_t *integer_to_float(integer_t *integer)
{
  float_t *new_float = (float_t*)allocate_type(type_float);
  mpf_init(new_float->value);
  mpf_set_z(new_float->value,integer->value);
  return new_float;
}

integer_t *float_to_integer(float_t *floatt)
{
  integer_t *new_int = (integer_t*)allocate_type(type_integer);
  mpz_init(new_int->value);
  mpz_set_f(new_int->value,floatt->value);
  return new_int;
}

list_t *string_to_list(string_t *string)
{
  int length = u_strlen(string->value);

  if(0 == length)
  {
    return make_list(NULL);
  }

  generic_list_t *items = make_generic_list(NULL);

  int i = 0;

  for(i = 0; i < length; i++)
  {
    character_t *next = make_character(string->value[i]);
    generic_list_add(items,next);
  }

  return make_list(items);
}

symbol_t name_get_value(value_t *name)
{
  return unpack_pointer_payload(name);
}

/*
  Creates a name with a single part consisting of 
  the symbol associated with 'string'.
*/

name_t *make_name(UChar *string)
{
  names++;
  const uint64_t name_mask = 0x81;
  return (name_t*) pack_tagged_pointer( name_mask, get_symbol(string) );
}

name_t *make_lookup(UChar *string)
{
  name_t *new_name = (name_t*)allocate_type(type_name);
  new_name->head = get_symbol(string);
  new_name->parts = 0;
  return new_name;
}

int name_is_lookup(name_t *name)
{
  return !is_tagged_pointer(name) && name->parts;
}

/*
  Creates a tag with the symbol associated with 'string'.
*/

tag_t *make_tag(UChar *string)
{
  const uint64_t tag_mask = 0x5;
  tags++;

  return (tag_t*)pack_tagged_pointer( tag_mask, get_symbol(string) );

  //return ((uint64_t)get_symbol(string) << 32) | tag_mask;
}

symbol_t tag_get_value(value_t *tag)
{
  return unpack_pointer_payload(tag);
}

/*
  Parses a Unicode string to a GMP integer point value and
  returns it wrapped in an integer value
*/

integer_t *make_integer_str(UChar *string)
{
  integer_t *new_number = (integer_t*)allocate_type(type_integer);
  mpz_init_set_str(new_number->value,from_unicode(string),0);
  return new_number;
}

/*
  Initialises a GMP integer value with an unsigned int and
  returns it wrapped in an integer value
*/

integer_t *make_integer(unsigned int integer)
{
  integer_t *new_number = (integer_t*)allocate_type(type_integer);
  mpz_init_set_ui(new_number->value,integer);
  return new_number;
}

/*
  Initialises a GMP floating point value from a double and
  returns it boxed in a float value
*/

float_t *make_float(double floating)
{
  float_t *new_number = (float_t*)allocate_type(type_float);
  mpf_init_set_d(new_number->value,floating);
  return new_number;
}

/*
  Parses a Unicode string to a GMP floating point value and
  returns it boxed in a float value
*/

float_t *make_float_str(UChar *string)
{
  float_t *new_number = (float_t*)allocate_type(type_float);
  mpf_init_set_str(new_number->value,from_unicode(string),0);
  return new_number;
}

/*
  Creates a new character object. It'd be a bit mean to make
  the caller heap allocate a word, wouldn't it? :-)
*/

character_t *make_character(UChar character)
{
  character_t *new_character = (character_t*)allocate_type(type_character);
  new_character->value = character;
  return new_character;
}

/*
  Creates a new string object from a Unicode string
*/

string_t *make_string(UChar *string)
{
  string_t *new_string = (string_t*)allocate_type(type_string);
  size_t string_length = u_strlen(string);
  UChar *string_buffer = GC_MALLOC((string_length + 1) * sizeof(UChar));
  // stupid hax :)
  u_unescape(from_unicode(string),string_buffer,string_length);
  *(string_buffer + string_length) = 0;
  new_string->value = string_buffer;
  return new_string;
}

/*
  Creates a mew list from the given generic_list_t. The caller is expected to
  allocate 'list' on the heap.
*/

list_t *make_list(generic_list_t *list)
{
  list_t *new_list = (list_t*)allocate_type(type_list);
  new_list->items = list;
  return new_list;
}

int list_empty(value_t *list)
{
  return (!((list_t*)list)->items || !((list_t*)list)->items->length);
}

value_t *list_index(value_t *value, int n)
{
  list_entry_t *item = value->list.items->first;
  return generic_list_index(value->list.items,n);
}

/*
  Creates a new reference object
*/

reference_t *make_reference(value_t *value)
{
  reference_t *new_reference = (reference_t*)allocate_type(type_reference);
  new_reference->value = value;
  return new_reference;
}

/*
  Creates a new append node from a list of lists
*/

append_t *make_append(generic_list_t *lists)
{
  append_t *new_append = (append_t*)allocate_type(type_append);
  new_append->lists = lists;
  return new_append;
}

/*
  Creates a new interpolate node from a list of lists
*/

interpolate_t *make_interpolate(generic_list_t *values)
{
  interpolate_t *new_interpolate = (interpolate_t*)allocate_type(type_interpolate);
  new_interpolate->values = values;
  return new_interpolate;
}

/*
  Creates a function with the given arguments and body. If tail is NULL, then
  the function is of fixed arity, else its "varargs" parameter is 'tail'. The
  caller is expected to allocate the parameters on the heap.
  
  Note: In the general case, a function won't bind 'recurse'. This must be
  set separately by the caller.
*/

function_t *make_function(generic_list_t *arguments, name_t *tail, generic_list_t *body)
{
  function_t *new_function = (function_t*)allocate_type(type_function);
  
  new_function->recursive = 0;
  new_function->arguments = arguments;
  new_function->tail = tail;
  new_function->body = body;
  
  return new_function;
}

/*
  Creates a closure from a literal function and its enclosing scope
*/

closure_t *make_closure(scope_t *scope, function_t *function)
{
  closure_t *closure = (closure_t*)allocate_type(type_closure);
  //closure->data = function->data;
  closure->function = function;
  closure->scope = scope;
    
  return closure;
}

/*
  Creates a call with the given head and arguments. The caller is expected
  to allocate these on the heap.
*/

call_t *make_call(value_t *head, generic_list_t *arguments)
{
  call_t *new_call = (call_t*)allocate_type(type_call);
  
  new_call->head = head;
  new_call->arguments = arguments;
  
  return new_call;
}

/*
  Creates a builtin function object with the given function pointer.
*/

builtin_t *make_builtin(name_t *name, value_t *(*function)(generic_list_t*,scope_t*,int,handler_t*), int arity, int varargs)
{
  builtin_t *new_builtin = (builtin_t*)allocate_type(type_builtin);
  
  new_builtin->name = name;
  new_builtin->function = function;
  new_builtin->arity = arity;
  new_builtin->varargs = varargs;
  
  return new_builtin;
}

/*
  Creates a trampoline from a given call object
*/

trampoline_t *make_trampoline(call_t *call, scope_t *scope)
{
  // trampoline_t *new_trampoline = (trampoline_t*)allocate_type(type_trampoline);
  
  thread_trampoline_buffer.call = call;
  thread_trampoline_buffer.closure = scope;
  
  return &thread_trampoline_buffer;
}
